home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / tool+ / textEdit < prev    next >
Encoding:
Text File  |  1993-05-31  |  2.7 KB  |  99 lines  |  [TEXT/ttxt]
  1. \ textEdit class based on bjr 1987
  2. \ 12.11.89    rfl now subclass of handle
  3. \ A lot of these methods leave the current font of the window changed.
  4. \ 4.17.91    rfl fixed rect1...actually should move into rect
  5. \ 4.23.91    rfl    added addText:
  6. \ 10.18.91    rfl    protect for 32k limit
  7.  
  8. $ 7fff value teLimit
  9.  
  10. :CLASS TextEdit <Super handle
  11.  
  12.     Rect ViewRect        \ as in IM V1
  13.     Rect DestRect        \ ditto
  14.  
  15.   :M  PtIn: ( -- b) where: theMouse pack ptIn: viewrect ;M 
  16.   :M  TEString: ( addr len  -- AbsAddr Length) swap +Base swap ;M
  17.   
  18.   \ first set up rects
  19.   :M  New: { myWind  -- }
  20.         alive: myWind not classerr" 133
  21.         PushPort set: myWind
  22.         0 Abs: DestRect Abs: ViewRect Call TENew m!
  23.         PopPort ;M
  24.  
  25.   :M  alive: ( -- b) m@ 0 <> ;M
  26.   
  27.   :M  close: m@ -dup IF Call TEDispose 0 m! THEN ;M
  28.   
  29.   :M  justify: ( Just --) MakeInt m@ Call TESetJust ;M
  30.   
  31.   :M  SetSelect: ( Start End --) m@ Call TESetSelect ;M
  32.   
  33.   :M  HighLight: 0 1000 setSelect: self ;M
  34.  
  35.   :M  moveTo: ( Position --) Dup SetSelect: Self ;M
  36.   
  37.   :M  Activate: m@ Call TEActivate ;M
  38.   
  39.   :M  Deactivate: m@ Call TEDeactivate ;M
  40.  
  41.   :M  teCut: m@ Call TECut ;M
  42.   
  43.   :M  teCopy: m@ Call TECopy ;M
  44.   
  45.   :M  tePaste: m@ Call TEPaste ;M
  46.  
  47.   :M  teDelete: m@ Call TEDelete ;M
  48.  
  49.   :M  GetScrap: ( -- addr len) global TEScrpHandle @ >ptr global TEScrpLength w@ ;M
  50.  
  51.   :M  PutText: ( addr len --) TEString: Self m@ Call TESetText ;M
  52.   
  53.   :M  GetText: ( -- addr len)
  54.         0 m@ Call TEGetText >ptr ptr: self 60 + w@  ;M
  55.  
  56.   :M  ReCal: m@ call TECalText ;M
  57.  
  58.   :M  textSize: ( -- len) getText: self swap drop ;M
  59.   
  60.   :M  overLimit?: ( len -- len b) dup textSize: self + teLimit > ;M
  61.  
  62.   :M  clear: 0 textSize: self setSelect: self TEDelete: self ;M
  63.   
  64.   :M  Insert: ( addr len --) TEString: Self m@ Call TEInsert ;M
  65.   
  66.   :M  Key: ( char --) MakeInt m@ Call TEKey ;M
  67.   
  68. \ could change teDelete to TeCut to do something with top of text
  69. \ for right now, delete twice the new addition and creep up to top again
  70.   :M  AddText: ( addr len --) overLimit?: self
  71.         IF 0 over 2* setSelect: self teDelete: self
  72.         THEN
  73.         textSize: self 1+ moveto: self insert: self ;M
  74.  
  75.   :M  Draw: clear: destRect
  76.         Abs: destRect m@ Call TEUpdate ;M
  77.   
  78.   :M  print:  abs: destRect m@ call TEUpdate ;M
  79.   
  80.   :M  Scroll: ( dh dv--)    pack m@ Call TEScroll ;M
  81.   
  82.   :M  Click: where: themouse pack false Bool m@ Call TEClick ;M
  83.   
  84.   :M  Idle: m@ Call TEIdle ;M
  85.   
  86.   :M  PutRect: ( l t r b --) put: viewRect  get: viewRect put: destRect
  87.         m@ IF get: destRect ptr: self put: rect
  88.               get: viewRect ptr: self 8+ put: rect
  89.             THEN ;M
  90.  
  91.   :M  ChangeRect: get: destRect ptr: self put: rect get: viewRect ptr: self 8+ put: rect ;M
  92.   
  93.   :M  OffSet: { dx dy -- }
  94.         dx dy OffSet: viewRect get: viewRect put: destRect ;M
  95.   
  96.   :M  InsetDest: ( dx dy --) Inset: DestRect ;M
  97.  
  98. ;CLASS
  99.